home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-setup.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-03-24  |  40.1 KB  |  1,476 lines
  1. /*  pl-setup.c,v 1.26 1995/02/07 12:12:31 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: Initialise the system
  8. */
  9.  
  10. /*#define O_DEBUG 1*/
  11.  
  12. #define GLOBAL                /* allocate global variables here */
  13. #include "pl-incl.h"
  14. #include <sys/stat.h>
  15. #ifdef HAVE_UNISTD_H
  16. #include <unistd.h>
  17. #endif
  18.  
  19. #undef ulong
  20. #define ulong unsigned long
  21. #undef max
  22. #define max(a,b) ((a) > (b) ? (a) : (b))
  23.  
  24. #define K * 1024
  25.  
  26. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  27. This module initialises the system and defines the global variables.  It
  28. also holds the code  for  dynamically  expanding  stacks  based  on  MMU
  29. access.   Finally  it holds the code to handle signals transparently for
  30. foreign language code or packages with which Prolog was linked together.
  31. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  32.  
  33. forwards void initStacks(long, long, long, long);
  34. forwards void initFeatures(void);
  35. forwards void initSignals(void);
  36.  
  37. #undef I
  38. #define I TAGEX_INDIRECT
  39.  
  40. const unsigned int tagtypeex[] = 
  41. {
  42.         /* var     int    float   atom   string   list    term     ref */
  43. /* static */    0,    0,    0,    0,    0,    0,    0,    0,
  44. /* heap */    0,    I,    I,    0,    I,    0,    0,    0,
  45. /* global */    0,    I,    I,    0,    I,    0,    0,    0,
  46. /* local */    0,    0,    0,    0,    0,    0,    0,    0
  47. };
  48.  
  49. #undef I
  50.  
  51. void
  52. setupProlog(void)
  53. { DEBUG(1, Sdprintf("Starting Heap Initialisation\n"));
  54.  
  55.   GD->critical = 0;
  56.   LD->aborted = FALSE;
  57.   signalled = 0;
  58.  
  59.   startCritical;
  60.   initMemAlloc();
  61. #if HAVE_SIGNAL
  62.   DEBUG(1, Sdprintf("Prolog Signal Handling ...\n"));
  63.   initSignals();
  64. #endif
  65.   DEBUG(1, Sdprintf("Stacks ...\n"));
  66.   initStacks(GD->options.localSize, 
  67.          GD->options.globalSize, 
  68.          GD->options.trailSize, 
  69.          GD->options.argumentSize);
  70.  
  71.   lTop = lBase;
  72.   tTop = tBase;
  73.   gTop = gBase;
  74.   aTop = aBase;
  75.  
  76.   base_addresses[STG_LOCAL]  = (unsigned long)lBase;
  77.   base_addresses[STG_GLOBAL] = (unsigned long)gBase;
  78.   base_addresses[STG_TRAIL]  = (unsigned long)tBase;
  79.   DEBUG(1, Sdprintf("base_addresses[STG_LOCAL] = %p\n",
  80.             base_addresses[STG_LOCAL]));
  81.   DEBUG(1, Sdprintf("base_addresses[STG_GLOBAL] = %p\n",
  82.             base_addresses[STG_GLOBAL]));
  83.   DEBUG(1, Sdprintf("base_addresses[STG_TRAIL] = %p\n",
  84.             base_addresses[STG_TRAIL]));
  85.  
  86. #ifdef O_LIMIT_DEPTH
  87.   depth_limit   = (unsigned long)DEPTH_NO_LIMIT;
  88.   depth_reached = 0;
  89. #endif
  90.  
  91.   emptyStacks();
  92.  
  93.   if ( !GD->dumped )
  94.   { DEBUG(1, Sdprintf("Atoms ...\n"));
  95.     initAtoms();
  96.     DEBUG(1, Sdprintf("Features ...\n"));
  97.     initFeatures();
  98.     DEBUG(1, Sdprintf("Functors ...\n"));
  99.     initFunctors();
  100.     DEBUG(1, Sdprintf("Modules ...\n"));
  101.     initTables();
  102.     initModules();
  103.     DEBUG(1, Sdprintf("Records ...\n"));
  104.     initRecords();
  105.     DEBUG(1, Sdprintf("Flags ...\n"));
  106.     initFlags();
  107.     DEBUG(1, Sdprintf("Foreign Predicates ...\n"));
  108.     initBuildIns();
  109.     DEBUG(1, Sdprintf("Operators ...\n"));
  110.     initOperators();
  111.     DEBUG(1, Sdprintf("Arithmetic ...\n"));
  112.     initArith();
  113.     DEBUG(1, Sdprintf("Tracer ...\n"));
  114.     initTracer();
  115.     debugstatus.styleCheck = SINGLETON_CHECK;
  116.     DEBUG(1, Sdprintf("wam_table ...\n"));
  117.     initWamTable();
  118.   } else
  119.   { resetReferences();
  120.     resetGC();                /* reset garbage collector */
  121.     GD->stateList = (State) NULL;    /* all states are already in core */
  122.   }
  123.   DEBUG(1, Sdprintf("IO ...\n"));
  124.   initIO();
  125.   DEBUG(1, Sdprintf("Loader ...\n"));
  126.   resetLoader();
  127.   DEBUG(1, Sdprintf("Symbols ...\n"));
  128.   getSymbols();
  129.   DEBUG(1, Sdprintf("Term ...\n"));
  130.   resetTerm();
  131.   GD->io_initialised = TRUE;
  132.  
  133.   endCritical;
  134.  
  135.   environment_frame = (LocalFrame) NULL;
  136.   LD->statistics.inferences = 0;
  137. #if O_STORE_PROGRAM || O_SAVE
  138.   GD->cannot_save_program = NULL;
  139. #else
  140.   GD->cannot_save_program = "Not supported on this machine";
  141. #endif
  142.  
  143. #if O_XWINDOWS
  144.   DEBUG(1, Sdprintf("XWindows ...\n");
  145.   initXWindows();
  146. #endif
  147.  
  148.   DEBUG(1, Sdprintf("Heap Initialised\n"));
  149. }
  150.  
  151. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  152. Feature interface
  153. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  154.  
  155. void
  156. CSetFeature(char *name, char *value)
  157. { setFeature(lookupAtom(name), FT_ATOM, lookupAtom(value));
  158. }
  159.  
  160. static void
  161. CSetIntFeature(char *name, long value)
  162. { setFeature(lookupAtom(name), FT_INTEGER, value);
  163. }
  164.  
  165. static void
  166. initFeatures()
  167. { CSetFeature("arch",        ARCH);
  168. #if __WIN32__
  169.   if ( iswin32s() )
  170.     CSetFeature("win32s",    "true");
  171.   CSetFeature("windows",    "true");
  172. #endif
  173.   CSetIntFeature("version",    PLVERSION);
  174.   if ( systemDefaults.home )
  175.     CSetFeature("home",        systemDefaults.home);
  176.   CSetFeature("c_libs",        C_LIBS);
  177.   CSetFeature("c_staticlibs",    C_STATICLIBS);
  178.   CSetFeature("c_cc",        C_CC);
  179.   CSetFeature("c_ldflags",    C_LDFLAGS);
  180.   CSetFeature("gc",        "true");
  181.   CSetFeature("trace_gc",    "false");
  182. #ifdef O_SAVE
  183.   CSetFeature("save",           "true");
  184.   CSetFeature("save_program",  "true");
  185. #endif
  186. #ifdef O_STORE_PROGRAM
  187.   CSetFeature("save_program",    "true");
  188. #endif
  189. #if defined(O_FOREIGN) || defined(O_MACH_FOREIGN) || defined(O_AIX_FOREIGN)
  190.   CSetFeature("load_foreign",  "true");
  191. #endif
  192. #if defined(HAVE_DLOPEN) || defined(HAVE_SHL_LOAD)
  193.   CSetFeature("open_shared_object", "true");
  194. #endif
  195. #ifdef O_DLL
  196.   CSetFeature("dll", "true");
  197. #endif
  198. #if O_DYNAMIC_STACKS
  199.   CSetFeature("dynamic_stacks",    "true");
  200. #endif
  201. #ifdef HAVE_POPEN
  202.   CSetFeature("pipe",        "true");
  203. #endif
  204. #ifdef ASSOCIATE_SRC
  205.   CSetFeature("associate",    ASSOCIATE_SRC);
  206. #endif
  207. #ifdef O_DDE
  208.   CSetFeature("dde",        "true");
  209. #endif
  210. #ifdef O_RUNTIME
  211.   CSetFeature("runtime",    "true");
  212.   CSetFeature("debug_on_error",    "false");
  213.   CSetFeature("report_error",    "false");
  214. #else
  215.   CSetFeature("debug_on_error",    "true");
  216.   CSetFeature("report_error",    "true");
  217. #endif
  218.                     /* ISO features */
  219.   CSetIntFeature("max_integer", PLMAXINT);
  220.   CSetIntFeature("min_integer", PLMININT);
  221.   CSetIntFeature("max_tagged_integer", PLMAXTAGGEDINT);
  222.   CSetIntFeature("min_tagged_integer", PLMINTAGGEDINT);
  223.   CSetFeature("bounded",    "true");
  224.   if ( (-3 / 2) == -2 )
  225.     CSetFeature("integer_rounding_function", "down");
  226.   else
  227.     CSetFeature("integer_rounding_function", "toward_zero");
  228.   CSetFeature("max_arity", "unbounded");
  229.   CSetFeature("float_format", "%g");
  230.   CSetFeature("character_escapes", "true");
  231.   CSetFeature("tty_control", GD->cmdline.notty ? "false" : "true");
  232.   CSetFeature("allow_variable_name_as_functor", "false");
  233. #if defined(__unix__) || defined(unix)
  234.   CSetFeature("unix", "true");
  235. #endif
  236.  
  237. #if defined(__DATE__) && defined(__TIME__)
  238.   { char buf[100];
  239.  
  240.     Ssprintf(buf, "%s, %s", __DATE__, __TIME__);
  241.     CSetFeature("compiled_at",    buf);
  242.   }
  243. #endif
  244. }
  245.  
  246. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  247.                SIGNAL HANDLING
  248.  
  249. SWI-Prolog catches a number of signals.  Interrupt is catched  to  allow
  250. the  user  to interrupt normal execution.  Floating point exceptions are
  251. trapped  to  generate  a  normal   error   or   arithmetic   exceptions.
  252. Segmentation  violations  are  trapped  on  machines  using  the  MMU to
  253. implement stack overflow  checks  and  stack  expansion.   These  signal
  254. handlers  needs  to be preserved over saved states and the system should
  255. allow foreign language code to handle signals without  interfering  with
  256. Prologs signal handlers.  For this reason a layer is wired around the OS
  257. signal handling.
  258.  
  259. Code in SWI-Prolog should  call  pl_signal()  rather  than  signal()  to
  260. install  signal  handlers.  SWI-Prolog assumes the handler function is a
  261. void function.  On some systems this gives  some  compiler  warnigns  as
  262. they  define  signal handlers to be int functions.  This should be fixed
  263. some day.
  264. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  265.  
  266. #if HAVE_SIGNAL
  267.  
  268. #ifdef __WIN32__
  269. #define HAVE_SIGNALS !iswin32s()
  270. #else
  271. #define HAVE_SIGNALS 1
  272. #endif
  273.  
  274. #if !O_DEBUG
  275. static void
  276. fatal_signal_handler(int sig, int type, SignalContext scp, char *addr)
  277. { DEBUG(1, Sdprintf("Fatal signal %d\n", sig));
  278.  
  279.   deliverSignal(sig, type, scp, addr);
  280. }
  281. #endif
  282.  
  283.  
  284. #ifdef HAVE_SIGSETMASK
  285. static int defsigmask;
  286. #endif
  287.  
  288. static void
  289. initSignals(void)
  290. { int n;
  291.  
  292.   if ( !GD->dumped )
  293.   { for( n = 0; n < MAXSIGNAL; n++ )
  294.     { LD_sig_handler(n).os = LD_sig_handler(n).user = SIG_DFL;
  295.       LD_sig_handler(n).catched = FALSE;
  296.     }
  297.  
  298. #ifdef SIGTTOU
  299.     pl_signal(SIGTTOU, SIG_IGN);
  300. #endif
  301. #if !O_DEBUG && !defined(_DEBUG)    /* just crash when debugging */
  302.     pl_signal(SIGSEGV, (handler_t)fatal_signal_handler);
  303.     pl_signal(SIGILL,  (handler_t)fatal_signal_handler);
  304. #ifdef SIGBUS
  305.     pl_signal(SIGBUS,  (handler_t)fatal_signal_handler);
  306. #endif
  307. #endif
  308.   } else
  309.   { for( n = 0; n < MAXSIGNAL; n++ )
  310.       if ( LD_sig_handler(n).os != SIG_DFL )
  311.         signal(n, LD_sig_handler(n).os);
  312.   }
  313.  
  314. #ifdef HAVE_SIGGETMASK
  315.   defsigmask = siggetmask();
  316. #else
  317. #ifdef HAVE_SIGBLOCK
  318.   defsigmask = sigblock(0);
  319. #endif
  320. #endif
  321. }
  322.  
  323.  
  324. void
  325. resetSignals()
  326. {
  327. #ifdef HAVE_SIGSETMASK            /* fixes Linux repeated ^C */
  328.   sigsetmask(defsigmask);
  329. #endif
  330.  
  331.   signalled = 0L;
  332. }
  333.  
  334.  
  335. handler_t
  336. pl_signal(int sig, handler_t func)
  337. { if ( HAVE_SIGNALS )
  338.   { handler_t old = signal(sig, func);
  339.  
  340.     DEBUG(1, Sdprintf("pl_signal(%d, %p) --> %p\n", sig, func, old));
  341.  
  342. #ifdef SIG_ERR
  343.     if ( old == SIG_ERR )
  344.       warning("PL_signal(%d, 0x%x) failed: %s",
  345.           sig, (unsigned long)func, OsError());
  346. #endif
  347.  
  348.     LD_sig_handler(sig).os = func;
  349.     LD_sig_handler(sig).catched = (func == SIG_DFL ? FALSE : TRUE);
  350.  
  351.     return old;
  352.   } else
  353.     return SIG_DFL;
  354. }
  355.  
  356.  
  357. void
  358. deliverSignal(int sig, int type, SignalContext scp, char *addr)
  359. { typedef RETSIGTYPE (*uhandler_t)(int, int, void *, char *);
  360.     
  361. #ifndef BSD_SIGNALS
  362.   signal(sig, LD_sig_handler(sig).os);    /* ??? */
  363. #endif
  364.  
  365.   if ( LD_sig_handler(sig).user != SIG_DFL )
  366.   { uhandler_t uh = (uhandler_t)LD_sig_handler(sig).user;
  367.  
  368.     (*uh)(sig, type, scp, addr);
  369.     return;
  370.   }
  371.  
  372.   sysError("Unexpected signal: %d\n", sig);
  373. }
  374.  
  375.  
  376. void
  377. PL_handle_signals()
  378. { typedef RETSIGTYPE (*uhandler_t)(int);
  379.  
  380.   while(signalled)
  381.   { ulong mask = 1L;
  382.     int sig = 1;
  383.  
  384.     for( ; ; mask <<= 1, sig++ )
  385.     { if ( signalled & mask )
  386.       { signalled &= ~mask;
  387.  
  388.     if ( LD_sig_handler(sig).os == SIG_DFL )
  389.     { fatalError("Unhandled signal: %d\n", sig);
  390.     } else if ( LD_sig_handler(sig).os != SIG_IGN )
  391.     { uhandler_t uh = (uhandler_t)LD_sig_handler(sig).os;
  392.  
  393.       (*uh)(sig);
  394.     }                /* SIG_IGN: ignored */
  395.  
  396.     break;
  397.       }
  398.     }
  399.   }
  400. }
  401.  
  402. #endif /*HAVE_SIGNAL*/
  403.  
  404.          /*******************************
  405.          *           STACKS        *
  406.          *******************************/
  407.  
  408. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  409. Create nice empty stacks. exception_bin   and  exception_printed are two
  410. term-references that must be low on  the   stack  to  ensure they remain
  411. valid while the stack is unrolled after an exception.
  412. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  413.  
  414. void
  415. emptyStacks()
  416. { environment_frame = NULL;
  417.   fli_context       = NULL;
  418.   lTop = lBase;
  419.   tTop = tBase;
  420.   gTop = gBase;
  421.   aTop = aBase;
  422.  
  423.   PL_open_foreign_frame();
  424.   exception_bin     = PL_new_term_ref();
  425.   exception_printed = PL_new_term_ref();
  426. }
  427.  
  428.  
  429. #if O_DYNAMIC_STACKS
  430.  
  431. static void init_stack(Stack s, char *name,
  432.                caddress base, long limit, long minsize);
  433. static void gcPolicy(Stack s, int policy);
  434.  
  435. #ifndef NO_SEGV_HANDLING
  436. #ifdef SIGNAL_HANDLER_PROVIDES_ADDRESS
  437. static RETSIGTYPE segv_handler(int sig, int type,
  438.                    SignalContext scp, char *addr);
  439. #else
  440. static RETSIGTYPE segv_handler(int sig);
  441. #endif
  442. #endif
  443.  
  444. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  445. STACK_SEPARATION defines the  space  between   the  stacks.  The maximum
  446. discontinuity while writing the local stack  is determined by the number
  447. of variables in the clause.  An example worst case is:
  448.  
  449. foo :-
  450.     (   failing_goal,
  451.         bar(term(A, B, C, ....))
  452.     ;   hello(AnotherVar)
  453.     ).
  454. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  455.  
  456. #define STACK_SEPARATION ROUND(MAXVARIABLES*sizeof(word), size_alignment)
  457. #define STACK_MINIMUM    (32 * 1024)
  458.  
  459. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  460.             STACK MEMORY MANAGEMENT
  461.  
  462. In these days some operating systems allows the  user  to  map  physical
  463. memory  anywhere  in  the  virtual  address  space.  For multiple stacks
  464. machines such as Prolog, this is ideal.  The  stacks  can  be  allocated
  465. very  far  appart  with  large  gaps  between  them.   Stack overflow is
  466. detected by hardware and results (in  Unix)  in  a  segmentation  fault.
  467. This fault is trapped and the stack is automatically expanded by mapping
  468. more  memory.
  469.  
  470. In theory the stacks can be deallocated dynamically as  well,  returning
  471. the  resources to the system.  Currently this can be done explicitely by
  472. calling  trim_stacks/0  and  the  garbage  collector.    It   might   be
  473. interesting  to  do  this  automatically  at  certain points to minimise
  474. memory requirements.  How?
  475.  
  476. Currently this mechanism can use mmap() and munmap() of SunOs 4.0 or the
  477. system-V shared memory primitives (if they meet certain criteria).
  478. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  479.  
  480. #include <errno.h>
  481. #ifndef WIN32
  482. extern int errno;
  483. #endif /*WIN32*/
  484.  
  485. static int size_alignment;    /* Stack sizes must be aligned to this */
  486. static int base_alignment;    /* Stack bases must be aligned to this */
  487.  
  488. #undef MB
  489. #define MB * (1024L * 1024L)
  490.  
  491. static long
  492. align_size(long int x)
  493. { return x % size_alignment ? (x / size_alignment + 1) * size_alignment : x;
  494. }
  495.  
  496. static long
  497. align_base(long int x)
  498. { return x % base_alignment ? (x / base_alignment + 1) * base_alignment : x;
  499. }
  500.  
  501. static long
  502. align_base_down(long int x)
  503. { return (x / base_alignment) * base_alignment;
  504. }
  505.  
  506. #ifdef MMAP_STACK
  507. #include <sys/mman.h>
  508. #include <fcntl.h>
  509.  
  510. static int mapfd = -1;            /* File descriptor used for mapping */
  511.  
  512. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  513. Return a file descriptor to a file, open  for  reading  and  holding  at
  514. least  one  page of 0's. On some systems /dev/zero is available for this
  515. trick.  If not, a file of one page is created under the name /tmp/pl-map
  516. if it does not already exists and this file is opened for  reading.   It
  517. can  be  shared  by  many  SWI-Prolog  processes  and (therefore) is not
  518. removed on exit.
  519. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  520.  
  521. #ifdef HAVE_MAP_ANON
  522. #if !defined(MAP_ANON) && defined(MAP_ANONYMOUS)
  523. #define MAP_ANON MAP_ANONYMOUS
  524. #endif
  525.  
  526. #define get_map_fd() (-1)
  527. #define STACK_MAP_TYPE MAP_ANON|MAP_PRIVATE|MAP_FIXED
  528.  
  529. #else /*HAVE_MAP_ANON*/
  530.  
  531. #define STACK_MAP_TYPE MAP_PRIVATE|MAP_FIXED
  532.  
  533. static int
  534. get_map_fd()
  535. { int fd;
  536.   static char *map = "/tmp/pl-map";
  537.  
  538.   if ( (fd = open("/dev/zero", O_RDONLY)) >= 0 )
  539.     return fd;
  540.  
  541.   if ( (fd = open(map, O_RDONLY)) < 0 )
  542.   { if ( errno == ENOENT )
  543.     { char buf[1024];
  544.       char *s;
  545.       int n;
  546.       int oldmask = umask(0);
  547.  
  548.       if ( (fd = open(map, O_RDWR|O_CREAT, 0666)) < 0 )
  549.       { fatalError("Can't create map file %s: %s", map, OsError());
  550.         return -1;
  551.       }
  552.       umask(oldmask);
  553.       for(n=1024, s = buf; n > 0; n--)
  554.         *s++ = EOS;
  555.       for(n=size_alignment/1024; n > 0; n--)
  556.       { if ( write(fd, buf, 1024) != 1024 )
  557.           fatalError("Failed to create map file %s: %s\n", map, OsError());
  558.       }
  559.  
  560.       return fd;
  561.     }
  562.     fatalError("Can't open map file %s: %s", map, OsError());
  563.     return -1;
  564.   }
  565.  
  566.   return fd;
  567. }
  568. #endif /*HAVE_MAP_ANON*/
  569.  
  570. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  571. Estimate the top if the heap. The default is to get the size of the heap
  572. using getrlimit(), add this to the estimated  base and use the result as
  573. top address.
  574.  
  575. This does not always appewar  to  work.   If  you  know the top, #define
  576. TOPOFHEAP in config.h. Othewise #define  it  to   0,  in  which case the
  577. system will allocate a default heap of 64 MB and the stacks above that.
  578. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  579.  
  580. #ifdef HAVE_GETRLIMIT
  581. #ifdef HAVE_SYS_RESOURCE_H
  582. #include <sys/resource.h>
  583. #endif
  584.  
  585. #ifdef RLIMIT_DATA
  586. #ifndef HAVE_RLIM_T
  587. typedef unsigned long rlim_t;
  588. #endif
  589. static ulong
  590. dataLimit()
  591. { struct rlimit limit;
  592.  
  593.   if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
  594.   { rlim_t datasize = limit.rlim_cur;
  595.     rlim_t maxlong  = (rlim_t)(1L << (LONGBITSIZE-1)) - 1;
  596.  
  597.     if ( datasize > maxlong )
  598.       datasize = (ulong)maxlong;
  599.  
  600.     return datasize;
  601.   }
  602.  
  603.   return 0L;
  604. }
  605. #else
  606. #define dataLimit() (0L)
  607. #endif /*RLIMIT_DATA*/
  608. #else
  609. #define dataLimit() (0L)
  610. #endif /*HAVE_GETRLIMIT*/
  611.  
  612.  
  613. #ifdef TOPOFHEAP
  614. #define topOfHeap() TOPOFHEAP
  615. #else /*TOPOFHEAP*/
  616. ulong
  617. topOfHeap()
  618. { ulong data = dataLimit();
  619.  
  620.   if ( data )
  621.   { ulong top = heap_base + data;
  622.  
  623.     DEBUG(1, Sdprintf("Heap: %p ... %p\n", (void *)heap_base, (void *)top));
  624.     return top;
  625.   }
  626.     
  627.   return 0L;
  628. }
  629. #endif /*TOPOFHEAP*/
  630.  
  631.  
  632. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  633. Expand stack `s' by one page.  This might not be  enough,  but  in  this
  634. (very  rare) case another segmentation fault will follow to get the next
  635. page.  The memory is expanded by mapping the map-fd file onto  the  page
  636. using  a  private  map.  This way the contents of the map-file is copied
  637. into the page but all changes to the page are  kept  local.   Note  that
  638. SunOs  4.0.0  on SUN-3 has a bug that causes the various mapped pages to
  639. point to the same physical memory.
  640. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  641.  
  642. static void
  643. mapOrOutOf(Stack s)
  644. { ulong incr;
  645.  
  646.   if ( s->top > s->max )
  647.     incr = ROUND(((ulong)s->top - (ulong)s->max), size_alignment);
  648.   else
  649.     incr = size_alignment;
  650.  
  651.   if ( (ulong)s->max + incr > (ulong)s->limit )
  652.     outOf(s);
  653.  
  654.   if ( mmap(s->max, incr,
  655.         PROT_READ|PROT_WRITE, STACK_MAP_TYPE,
  656.         mapfd, 0L) != s->max )
  657.     fatalError("Failed to map memory at 0x%x for %d bytes on fd=%d: %s\n",
  658.            s->max, incr, mapfd, OsError());
  659.  
  660.   DEBUG(1, Sdprintf("mapped %d bytes from 0x%x to 0x%x\n",
  661.             size_alignment, (unsigned) s->max, s->max + incr));
  662.   s->max = addPointer(s->max, incr);
  663.   considerGarbageCollect(s);
  664. }
  665.  
  666.  
  667. #ifdef NO_SEGV_HANDLING
  668. void
  669. ensureRoomStack(Stack s, int bytes)
  670. { while((char *)s->max - (char *)s->top < (int)bytes)
  671.     mapOrOutOf(s);
  672. }
  673. #endif
  674.  
  675. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  676. unmap() returns all memory resources of a stack that are  no  longer  in
  677. use to the OS.
  678. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  679.  
  680. static void
  681. unmap(Stack s)
  682. { caddress top  = (s->top > s->min ? s->top : s->min);
  683.   caddress addr = (caddress) align_size((long) top + size_alignment);
  684.  
  685.   if ( addr < s->max )
  686.   { if ( munmap(addr, (char *)s->max - (char *)addr) != 0 )
  687.       fatalError("Failed to unmap memory: %s", OsError());
  688.     s->max = addr;
  689.   }
  690. }
  691.  
  692.  
  693. #ifdef O_SAVE
  694.  
  695. static void
  696. deallocateStack(Stack s)
  697. { long len = (unsigned long)s->max - (unsigned long)s->base;
  698.  
  699.   if ( len > 0 && munmap(s->base, len) != 0 )
  700.     fatalError("Failed to unmap memory: %s", OsError());
  701. }
  702.  
  703.  
  704. void
  705. deallocateStacks(void)
  706. { deallocateStack((Stack) &LD->stacks.local);
  707.   deallocateStack((Stack) &LD->stacks.global);
  708.   deallocateStack((Stack) &LD->stacks.trail);
  709.   deallocateStack((Stack) &LD->stacks.argument);
  710. }
  711.  
  712.  
  713. bool
  714. restoreStack(Stack s)
  715. { caddress max;
  716.   long len;
  717.   struct stat statbuf;
  718.  
  719.   if ( mapfd < 0 || fstat(mapfd, &statbuf) == -1 )
  720.   { mapfd = get_map_fd();
  721.     base_alignment = size_alignment = getpagesize();
  722.   }
  723.  
  724.   max = (caddress) align_size((long) s->top + 1);
  725.   len = max - (caddress) s->base;
  726.  
  727.   if ( mmap(s->base, len,
  728.         PROT_READ|PROT_WRITE, STACK_MAP_TYPE,
  729.         mapfd, 0L) != s->base )
  730.     fatalError("Failed to map memory at 0x%x for %d bytes on fd=%d: %s\n",
  731.            s->base, len, mapfd, OsError());
  732.  
  733.   s->max = max;
  734.   DEBUG(0, Sdprintf("mapped %d bytes from 0x%x\n", len, (unsigned) s->base));
  735.   succeed;
  736. }
  737. #endif /*O_SAVE*/
  738.  
  739. #endif /* MMAP_STACK */
  740.  
  741. #if O_SHARED_MEMORY
  742. #include <sys/stat.h>
  743. #include <sys/ipc.h>
  744. #include <sys/shm.h>
  745. #if gould
  746. #define S_IRUSR SHM_R
  747. #define S_IWUSR SHM_W
  748. #endif
  749. #if mips
  750. struct pte { long pad };        /* where is the real one? */
  751. #include <sys/param.h>
  752. #endif
  753.  
  754. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  755. Shared memory based MMU controlled stacks are a bit  more  tricky.   The
  756. main  problem is that shared memory segments are scares resources.  Upto
  757. a certain limit, each time the size of the stack is doubled.  Afterwards
  758. the stack grows in fixed segments  of  size  s->segment_initial  *  2  ^
  759. s->segment_double.   These  parameters  may  vary  from  stack to stack,
  760. suiting the caracteristics of the stack and of the OS limits on  virtual
  761. address space and number of shared memory segnments.  See pl-incl.h
  762.  
  763. The  shared  memory  segments  are  created,  mapped   and   immediately
  764. afterwards  freed.   According  to  the documentation they actually will
  765. live untill they are unmapped by the last process.  Immediately  freeing
  766. them  avoids the burden to do this on exit() and ensures these resources
  767. are freed, also if SWI-Prolog crashes.
  768. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  769.  
  770. #if O_SHM_ALIGN_FAR_APART
  771.  
  772. #define min(a, b) ((a) < (b) ? (a) : (b))
  773.  
  774. static long
  775. new_stack_size(s)
  776. Stack s;
  777. { long size  = s->top - s->base;
  778.   long free  = size / s->segment_initial;
  779.   long limit = diffPointers(s->limit, s->base);
  780.  
  781.   if ( free > s->segment_double ) free = s->segment_double;
  782.   else if ( free < 1 )            free = 1;
  783.   
  784.   size = align_size(size + free * s->segment_initial);  
  785.  
  786.   if ( size > limit )
  787.     size = limit;
  788.  
  789.   return size;
  790. }
  791.  
  792. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  793. resize_segment(s, n, size)
  794.   Resize segment n of stack s to get size size.  The base address of the
  795.   segement is assumed to be correct.
  796. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  797.  
  798. static void
  799. resize_segment(s, n, size)
  800. Stack s;
  801. int n;
  802. long size;
  803. { if ( s->segments[n].size != size )
  804.   { int id = -1;
  805.     char *addr;
  806.  
  807.     if ( size > 0 )
  808.     { if ( (id=shmget(IPC_PRIVATE, size, S_IRUSR|S_IWUSR)) < 0 )
  809.     fatalError("Failed to create shared memory object: %s", OsError());
  810.       if ( (addr = shmat(id, 0, 0)) < 0 )
  811.     fatalError("Failed to attach shared memory segment: %s", OsError());
  812.       memcpy(s->segments[n].base, addr, min(size, s->segments[n].size));
  813.       if ( shmdt(addr) < 0 )
  814.           fatalError("Failed to detach shared memory segment: %s", OsError());
  815.     }    
  816.  
  817.     if ( s->segments[n].size > 0 )
  818.       if ( shmdt(s->segments[n].base) < 0 )
  819.           fatalError("Failed to detach shared memory segment: %s", OsError());
  820.     
  821.     if ( id >= 0 )
  822.     { DEBUG(0, Sdprintf("Attach segment of size %ld at 0x%x\n",
  823.               size, s->segments[n].base));
  824.       if ( shmat(id, s->segments[n].base, 0) != s->segments[n].base )
  825.           fatalError("Failed to attach shared memory segment at 0x%x: %s",
  826.            s->segments[n].base, OsError());
  827.       
  828.       if ( shmctl(id, IPC_RMID, NULL) < 0 )
  829.     fatalError("Failed to release shared memory object: %s", OsError());
  830.     }
  831.  
  832.     s->segments[n].size = 0;
  833.   }
  834. }
  835.  
  836.  
  837. void
  838. mapOrOutOf(Stack s)
  839. { long new_size = new_stack_size(s);
  840.   int  top_segment = new_size / base_alignment;
  841.   int  n;
  842.  
  843.   DEBUG(1, Sdprintf("Expanding %s stack to %ld\n", s->name, new_size));
  844.  
  845.   for(n=0; n < top_segment; n++)
  846.     resize_segment(s, n, base_alignment);
  847.  
  848.   resize_segment(s, n, new_size % base_alignment);
  849.  
  850.   for(n++; s->segments[n].size > 0; n++ )
  851.     resize_segment(s, n, 0L);
  852.  
  853.   s->max = s->base + new_size;
  854.   considerGarbageCollect(s);
  855. }
  856.  
  857.  
  858. static void
  859. unmap(Stack s)
  860. { if ( new_stack_size(s) < s->max - s->base )
  861.     mapOrOutOf(s);
  862. }
  863.  
  864. #else /* O_SHM_ALIGN_FAR_APART */
  865.  
  866. void
  867. mapOrOutOf(Stack s)
  868. { int id;
  869.   char *rval;
  870.   long len;
  871.   caddress addr;
  872.  
  873.   len  = (s->segment_top <= s->segment_double
  874.               ? s->segment_initial << (s->segment_top)
  875.               : s->segment_initial << s->segment_double);
  876.   addr = s->segments[s->segment_top].base;
  877.  
  878.   if ( (id=shmget(IPC_PRIVATE, len, S_IRUSR|S_IWUSR)) < 0 )
  879.   { if ( errno == EINVAL )
  880.       fatalError("Kernel is not configured with option IPCSHMEM (contact a guru)");
  881.     fatalError("Failed to create shared memory object: %s", OsError());
  882.   }
  883.  
  884.   if ( (rval = shmat(id, addr, 0)) != (char *) addr )
  885.     fatalError("Failed to map memory at %ld: %s\n", addr, OsError());
  886.  
  887.   if ( shmctl(id, IPC_RMID, NULL) < 0 )
  888.     fatalError("Failed to release shared memory object: %s", OsError());
  889.  
  890.   s->segment_top++;
  891.   s->max = s->segments[s->segment_top].base = addr+len;
  892.   considerGarbageCollect(s);
  893. }
  894.  
  895.  
  896. static void
  897. unmap(Stack s)
  898. { while( s->segment_top > 0 && s->segments[s->segment_top-1].base > s->top )
  899.   { s->segment_top--;
  900.     if ( shmdt(s->segments[s->segment_top].base) < 0 )
  901.       fatalError("Failed to unmap: %s\n", OsError());
  902.     s->max = s->segments[s->segment_top].base;
  903.   }
  904. }
  905.  
  906. #endif /* O_SHM_ALIGN_FAR_APART */
  907. #endif /* O_SHARED_MEMORY */
  908.  
  909. #ifdef SIGNAL_HANDLER_PROVIDES_ADDRESS
  910. static bool
  911. expandStack(Stack s, caddress addr)
  912. { if ( addr < s->max || addr >= addPointer(s->limit, STACK_SEPARATION) )
  913.     fail;                /* outside this area */
  914.  
  915.   if ( addr <= s->max + STACK_SEPARATION*2 )
  916.   { if ( addr < s->limit )
  917.     { DEBUG(1, Sdprintf("Expanding %s stack\n", s->name));
  918.       mapOrOutOf(s);
  919.  
  920.       succeed;
  921.     }
  922.  
  923.     outOf(s);   
  924.   }
  925.  
  926.   fail;
  927. }
  928. #endif /*O_SHARED_MEMORY*/
  929.  
  930. #ifdef HAVE_VIRTUAL_ALLOC
  931.  
  932. #undef FD_ZERO
  933. #undef FD_ISSET
  934. #undef FD_SET
  935. #include <windows.h>
  936. #undef small
  937.  
  938. static void
  939. mapOrOutOf(Stack s)
  940. { ulong incr;
  941.  
  942.   if ( s->top > s->max )
  943.     incr = ROUND(((ulong)s->top - (ulong)s->max), size_alignment);
  944.   else
  945.     incr = size_alignment;
  946.  
  947.   if ( addPointer(s->max, incr) > s->limit )
  948.     outOf(s);
  949.  
  950.   if ( VirtualAlloc(s->max, incr,
  951.             MEM_COMMIT, PAGE_READWRITE ) != s->max )
  952.     fatalError("VirtualAlloc() failed at 0x%x for %d bytes: %d\n",
  953.            s->max, incr, GetLastError());
  954.  
  955.   DEBUG(1, Sdprintf("mapped %d bytes from 0x%x to 0x%x\n",
  956.             incr, (unsigned) s->max,
  957.             (ulong) s->max + size_alignment));
  958.  
  959.   s->max = addPointer(s->max, incr);
  960.   considerGarbageCollect(s);
  961. }
  962.  
  963.  
  964. #ifdef NO_SEGV_HANDLING
  965. void
  966. ensureRoomStack(Stack s, int bytes)
  967. { while((char *)s->max - (char *)s->top < (int)bytes)
  968.     mapOrOutOf(s);
  969. }
  970. #endif
  971.  
  972. static void
  973. unmap(Stack s)
  974. { caddress top  = (s->top > s->min ? s->top : s->min);
  975.   caddress addr = (caddress) align_size((long) top + size_alignment);
  976.  
  977.   if ( addr < s->max )
  978.   { if ( !VirtualFree(addr, (ulong)s->max - (ulong)addr, MEM_DECOMMIT) )
  979.       fatalError("Failed to unmap memory: %d", GetLastError());
  980.     s->max = addr;
  981.   }
  982. }
  983.  
  984.  
  985. #define MAX_VIRTUAL_ALLOC (100 MB)
  986. #define SPECIFIC_INIT_STACK 1
  987.  
  988. static void
  989. initStacks(long local, long global, long trail, long argument)
  990. { SYSTEM_INFO info;
  991.   int large = 0;            /* number of `large' stacks */
  992.   ulong base;                /* allocation base */
  993.   ulong totalsize;            /* total size to allocate */
  994.  
  995.   GetSystemInfo(&info);
  996.   size_alignment = info.dwPageSize;
  997.   base_alignment = size_alignment;
  998. /*base_alignment = info.dwAllocationGranularity;*/
  999.  
  1000.   local    = (long) align_size(local);    /* Round up to page boundary */
  1001.   global   = (long) align_size(global);
  1002.   trail    = (long) align_size(trail);
  1003.   argument = (long) align_size(argument);
  1004.  
  1005.   if ( local    == 0 ) large++;        /* find dynamic ones */
  1006.   if ( global   == 0 ) large++;
  1007.   if ( trail    == 0 ) large++;
  1008.   if ( argument == 0 ) large++;
  1009.  
  1010.   if ( large )
  1011.     totalsize = MAX_VIRTUAL_ALLOC;
  1012.   else
  1013.     totalsize = local + global + trail + argument + 4 * STACK_SEPARATION;
  1014.  
  1015.   if ( !(base = (ulong) VirtualAlloc(NULL, totalsize,
  1016.                      MEM_RESERVE, PAGE_READWRITE)) )
  1017.     fatalError("Failed to allocate stacks for %d bytes: %d",
  1018.            totalsize, GetLastError());
  1019.  
  1020.   if ( large )
  1021.   { ulong space = totalsize -
  1022.            ( align_base(local + STACK_SEPARATION) +
  1023.          align_base(global + STACK_SEPARATION) +
  1024.          align_base(trail + STACK_SEPARATION) +
  1025.          align_base(argument) );
  1026.     ulong large_size = ((space / large) / base_alignment) * base_alignment;
  1027.  
  1028.     if ( large_size < STACK_MINIMUM )
  1029.       fatalError("Can't fit requested stack sizes in address space");
  1030.     DEBUG(1, Sdprintf("Large stacks are %ld\n", large_size));
  1031.  
  1032.     if ( local    == 0 ) local    = large_size;
  1033.     if ( global   == 0 ) global   = large_size;
  1034.     if ( trail    == 0 ) trail    = large_size;
  1035.     if ( argument == 0 ) argument = large_size;
  1036.   }
  1037.  
  1038. #define INIT_STACK(name, print, limit, minsize) \
  1039.   DEBUG(1, Sdprintf("%s stack at 0x%x; size = %ld\n", print, base, limit)); \
  1040.   init_stack((Stack) &LD->stacks.name, print, (caddress) base, limit, minsize); \
  1041.   base += limit + STACK_SEPARATION; \
  1042.   base = align_base(base);
  1043. #define K * 1024
  1044.  
  1045.   INIT_STACK(global,   "global",   global,   16 K);
  1046.   INIT_STACK(local,    "local",    local,    8 K);
  1047.   INIT_STACK(trail,    "trail",    trail,    8 K);
  1048.   INIT_STACK(argument, "argument", argument, 1 K);
  1049.  
  1050. #ifndef NO_SEGV_HANDLING
  1051.   pl_signal(SIGSEGV, (handler_t) segv_handler);
  1052. #endif
  1053. }
  1054.  
  1055. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1056. Reset the stacks after an abort
  1057. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1058.  
  1059. void
  1060. resetStacks()
  1061. { emptyStacks();
  1062.  
  1063. #ifndef NO_SEGV_HANDLING
  1064.   pl_signal(SIGSEGV, (handler_t) segv_handler);
  1065. #endif
  1066.   trimStacks();
  1067. }
  1068.  
  1069. #endif /*HAVE_VIRTUAL_ALLOC*/
  1070.  
  1071. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1072. This the the signal handler for segmentation faults if we are using  MMU
  1073. controlled  stacks.   The  only  argument  we  are  interested in is the
  1074. address of the segmentation fault.  SUN provides this via  an  argument.
  1075. If   your   system   does   not   provide   this  information,  set  the
  1076. SIGNAL_HANDLER_PROVIDES_ADDRESS flag.
  1077. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1078.  
  1079. #ifndef NO_SEGV_HANDLING
  1080. static RETSIGTYPE
  1081. #ifdef SIGNAL_HANDLER_PROVIDES_ADDRESS
  1082. segv_handler(int sig, int type, SignalContext scp, char *addr)
  1083. #else
  1084. segv_handler(int sig)
  1085. #endif
  1086. { Stack stacka = (Stack) &LD->stacks;
  1087.   int i;
  1088.  
  1089. #ifndef SIGNAL_HANDLER_PROVIDES_ADDRESS
  1090.   int mapped = 0;
  1091.  
  1092.   DEBUG(1, Sdprintf("Page fault.  Free room (g+l+t) = %ld+%ld+%ld\n",
  1093.             roomStack(global), roomStack(local), roomStack(trail)));
  1094.  
  1095.   for(i=0; i<N_STACKS; i++)
  1096.   { long r = (ulong)stacka[i].max - (ulong)stacka[i].top;
  1097.  
  1098.     if ( r < size_alignment )
  1099.     { DEBUG(1, Sdprintf("Mapped %s stack (free was %d)\n", stacka[i].name, r));
  1100.       mapOrOutOf(&stacka[i]);
  1101.       mapped++;
  1102.     }
  1103.   }
  1104.  
  1105.   if ( mapped )
  1106.   {
  1107. #ifndef BSD_SIGNALS
  1108.     signal(SIGSEGV, (handler_t) segv_handler);
  1109. #endif
  1110.     return;
  1111.   }
  1112.  
  1113. #else /*SIGNAL_HANDLER_PROVIDES_ADDRESS*/
  1114.  
  1115.   DEBUG(1, Sdprintf("Page fault at %ld (0x%x)\n", (long) addr, (unsigned) addr));
  1116.   for(i=0; i<N_STACKS; i++)
  1117.     if ( expandStack(&stacka[i], addr) )
  1118.     {
  1119. #ifndef BSD_SIGNALS
  1120.       signal(sig, (handler_t) segv_handler);
  1121. #endif
  1122.       return;
  1123.     }
  1124. #endif /*SIGNAL_HANDLER_PROVIDES_ADDRESS*/
  1125.  
  1126. #ifdef SIGNAL_HANDLER_PROVIDES_ADDRESS
  1127.   deliverSignal(sig, type, scp, addr);
  1128. #else
  1129.   deliverSignal(sig, 0, 0, NULL);    /* for now ... */
  1130. #endif
  1131. }
  1132.  
  1133. #endif /*NO_SEGV_HANDLING*/
  1134.  
  1135. static void
  1136. init_stack(Stack s, char *name, caddress base, long limit, long minsize)
  1137. { s->name      = name;
  1138.   s->base      = s->max = s->top = base;
  1139.   s->limit     = addPointer(base, limit);
  1140.   s->min       = (caddress)((ulong)s->base + minsize);
  1141.   s->gced_size = 0L;            /* size after last gc */
  1142.   gcPolicy(s, GC_FAST_POLICY);
  1143. #if O_SHARED_MEMORY
  1144. #if O_SHM_ALIGN_FAR_APART
  1145. { int n;
  1146.  
  1147.   s->segment_initial = 32 * 1024;
  1148.   s->segment_double  = 20;
  1149.   for(n=0; n < MAX_STACK_SEGMENTS; n++)
  1150.   { s->segments[n].size = 0;
  1151.     s->segments[n].base = s->base + base_alignment * n;
  1152.   }
  1153. }
  1154. #else /* O_SHM_ALIGN_FAR_APART */
  1155.   s->segment_top     = 0;
  1156.   s->segment_initial = 32 * 1024;
  1157.   s->segment_double  = 5;
  1158.   s->segments[0].base = base;
  1159. #endif /* O_SHM_ALIGN_FAR_APART */
  1160. #endif /* O_SHARED_MEMORY */
  1161.  
  1162.   DEBUG(1, Sdprintf("%-8s stack from 0x%08x to 0x%08x\n",
  1163.             s->name, (ulong)s->base, (ulong)s->limit));
  1164.  
  1165.   while(s->max < s->min)
  1166.     mapOrOutOf(s);
  1167. }
  1168.  
  1169. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1170. initStacks() initialises the stacks structure,  thus  assigning  a  base
  1171. address,  a limit and a name to each of the stacks.  Finally it installs
  1172. a signal handler for handling  segmentation  faults.   The  segmentation
  1173. fault handler will actually create and expand the stacks on segmentation
  1174. faults.
  1175.  
  1176. The big problem is finding a safe   area  for the stacks. Currently, the
  1177. system tries to find an area as far   as possible from the heap, growing
  1178. downwards  if  it  can  determine  the    top  of  the  heap-area  using
  1179. topOfHeap(). If it cannot, it will work from the current top of the heap
  1180. as returned by sbrk(0).
  1181. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1182.  
  1183. #ifdef FORCED_MALLOC_BASE
  1184. #undef MMAP_MAX_ADDRESS
  1185. #undef MMAP_MIN_ADDRESS
  1186. #define MMAP_MAX_ADDRESS (FORCED_MALLOC_BASE + 64 MB)
  1187. #define MMAP_MIN_ADDRESS (FORCED_MALLOC_BASE + 16 MB)
  1188. #endif
  1189.  
  1190. #ifndef SPECIFIC_INIT_STACK
  1191.  
  1192. static void
  1193. initStacks(long local, long global, long trail, long argument)
  1194. { int large = 0;
  1195.   ulong base, top, space, large_size, min_space;
  1196.  
  1197.   size_alignment = getpagesize();
  1198. #ifdef MMAP_STACK
  1199.   base_alignment = size_alignment;
  1200.   mapfd  = get_map_fd();
  1201. #endif
  1202. #if O_SHARED_MEMORY
  1203.   base_alignment = SHMLBA;
  1204.   DEBUG(0, Sdprintf("Shared memory must be aligned to %d (0x%x) bytes\n",
  1205.           base_alignment, base_alignment));
  1206. #endif
  1207.  
  1208.   local    = (ulong) align_size(local);    /* Round up to page boundary */
  1209.   global   = (ulong) align_size(global);
  1210.   trail    = (ulong) align_size(trail);
  1211.   argument = (ulong) align_size(argument);
  1212.  
  1213.   min_space = align_base(1) +
  1214.           align_base(local + STACK_SEPARATION) +
  1215.           align_base(global + STACK_SEPARATION) +
  1216.           align_base(trail + STACK_SEPARATION) +
  1217.           align_base(argument);
  1218.  
  1219.   if ( local    == 0 ) large++;        /* find dynamic ones */
  1220.   if ( global   == 0 ) large++;
  1221.   if ( trail    == 0 ) large++;
  1222.   if ( argument == 0 ) large++;
  1223.  
  1224.   if ( (top = topOfHeap()) > 0L && !GD->options.heapSize )
  1225.   { if ( large > 0 )            /* we have dynamic stacks */
  1226.     { base = heap_base;
  1227.       space = top - base;
  1228.       space -= min_space;
  1229.       large++;                /* heap as well */
  1230.       large_size = ((space / large+1) / base_alignment) * base_alignment;
  1231.       if ( large_size > 64 MB )
  1232.     large_size = 64 MB;
  1233.       if ( large_size < STACK_MINIMUM )
  1234.     fatalError("Can't fit requested stack sizes in address space");
  1235.       DEBUG(1, Sdprintf("Large stacks are %ld\n", large_size));
  1236.  
  1237.       if ( local    == 0 ) local    = large_size;
  1238.       if ( global   == 0 ) global   = large_size;
  1239.       if ( trail    == 0 ) trail    = large_size;
  1240.       if ( argument == 0 ) argument = large_size;
  1241.     }
  1242.  
  1243.     base = top - (align_base(1) +
  1244.           align_base(local + STACK_SEPARATION) +
  1245.           align_base(global + STACK_SEPARATION) +
  1246.           align_base(trail + STACK_SEPARATION) +
  1247.           align_base(argument));
  1248.     base = align_base_down(base);
  1249.   } else                /* we don't know the top */
  1250.   { ulong maxdata = dataLimit();
  1251.  
  1252.     if ( !GD->options.heapSize )
  1253.     { if ( maxdata )
  1254.       { large_size = align_base_down((maxdata-min_space)/(large+1));
  1255.     large_size = max(large_size, 64 MB);
  1256.       } else
  1257.     large_size = 64 MB;
  1258.     
  1259.       GD->options.heapSize = large_size;
  1260.     } else
  1261.     { large_size = align_base_down((maxdata-min_space)/(large+1));
  1262.       large_size = max(large_size, 64 MB);
  1263.     }
  1264.  
  1265. #ifdef MMAP_MIN_ADDRESS
  1266.     base = MMAP_MIN_ADDRESS;
  1267. #else
  1268.     base = (ulong) align_base((ulong)sbrk(0) + GD->options.heapSize);
  1269. #endif
  1270.  
  1271.     if ( large > 0 )
  1272.     { DEBUG(1, Sdprintf("Large stacks are %ld\n", large_size));
  1273.   
  1274.       if ( local    == 0 ) local    = large_size;
  1275.       if ( global   == 0 ) global   = large_size;
  1276.       if ( trail    == 0 ) trail    = large_size;
  1277.       if ( argument == 0 ) argument = large_size;
  1278.     }
  1279.   }
  1280.  
  1281. #define INIT_STACK(name, print, limit, minsize) \
  1282.   DEBUG(1, Sdprintf("%s stack at 0x%x; size = %ld\n", print, base, limit)); \
  1283.   init_stack((Stack) &LD->stacks.name, print, (caddress) base, limit, minsize); \
  1284.   base += limit + STACK_SEPARATION; \
  1285.   base = align_base(base);
  1286. #define K * 1024
  1287.  
  1288.   INIT_STACK(global,   "global",   global,   16 K);
  1289.   INIT_STACK(local,    "local",    local,    8 K);
  1290.   INIT_STACK(trail,    "trail",    trail,    8 K);
  1291.   INIT_STACK(argument, "argument", argument, 1 K);
  1292.  
  1293.   assert(top == 0L || (ulong)aLimit <= top);
  1294.  
  1295. #ifndef NO_SEGV_HANDLING
  1296.   pl_signal(SIGSEGV, (handler_t) segv_handler);
  1297. #endif
  1298. }
  1299.  
  1300. void
  1301. resetStacks()
  1302. { emptyStacks();
  1303.  
  1304. #ifndef NO_SEGV_HANDLING
  1305.   pl_signal(SIGSEGV, (handler_t) segv_handler);
  1306. #endif
  1307.   trimStacks();
  1308. }
  1309.  
  1310.  
  1311. #endif /*SPECIFIC_INIT_STACK*/
  1312.  
  1313.         /********************************
  1314.         *     STACK TRIMMING & LIMITS   *
  1315.         *********************************/
  1316.  
  1317. static void
  1318. gcPolicy(Stack s, int policy)
  1319. { s->gc = ((s == (Stack) &LD->stacks.global ||
  1320.         s == (Stack) &LD->stacks.trail) ? TRUE : FALSE);
  1321.   if ( s->gc )
  1322.   { s->small  = SMALLSTACK;
  1323.     s->factor = 3;
  1324.     s->policy = policy;
  1325.   } else
  1326.   { s->small  = 0;
  1327.     s->factor = 0;
  1328.     s->policy = 0;
  1329.   }
  1330. }
  1331.  
  1332.  
  1333. word
  1334. pl_trim_stacks()
  1335. { trimStacks();
  1336.  
  1337.   gcPolicy((Stack) &LD->stacks.global, GC_FAST_POLICY);
  1338.   gcPolicy((Stack) &LD->stacks.trail,  GC_FAST_POLICY);
  1339.  
  1340.   succeed;
  1341. }
  1342.  
  1343.  
  1344. #else /* O_DYNAMIC_STACKS */
  1345.  
  1346.         /********************************
  1347.         *    SIMPLE STACK ALLOCATION    *
  1348.         *********************************/
  1349.  
  1350. forwards void init_stack(Stack, char *, long, long, long);
  1351.  
  1352. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1353. On systems that do not allow us to get access to the MMU (or that do not
  1354. have an MMU)  the  stacks  have  fixed  size  and  overflow  checks  are
  1355. implemented  in  software.   The stacks are allocated using malloc(). If
  1356. you malloc() does not allow you to get more than 64K bytes in one go you
  1357. better start looking for another Prolog system (IBM-PC  is  an  example:
  1358. why does IBM bring computers on the marked that are 10 years out-of-date
  1359. at the moment of announcement?).
  1360. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1361.  
  1362. word
  1363. pl_trim_stacks()
  1364. { succeed;
  1365. }
  1366.  
  1367.  
  1368. word
  1369. pl_stack_parameter(term_t name, term_t key, term_t old, term_t new)
  1370. { atom_t a, k;
  1371.   Stack stack = NULL;
  1372.   long *value = NULL;
  1373.  
  1374.   if ( PL_get_atom(name, &a) )
  1375.   { if ( a == ATOM_local )
  1376.       stack = (Stack) &LD->stacks.local;
  1377.     else if ( a == ATOM_global )
  1378.       stack = (Stack) &LD->stacks.global;
  1379.     else if ( a == ATOM_trail )
  1380.       stack = (Stack) &LD->stacks.trail;
  1381.     else if ( a == ATOM_argument )
  1382.       stack = (Stack) &LD->stacks.argument;
  1383.   }
  1384.   if ( !stack )
  1385.     return warning("stack_parameter/4: unknown stack");
  1386.  
  1387.   if ( PL_get_atom(key, &k) )
  1388.   { if ( k == ATOM_min_free )
  1389.       value = &stack->minfree;
  1390.   }
  1391.   if ( !value )
  1392.     return warning("stack_parameter/4: unknown key");
  1393.  
  1394.   return setLong(value, "stack_parameter/4", old, new);
  1395. }
  1396.  
  1397.  
  1398. static void
  1399. init_stack(Stack s, char *name, long size, long limit, long minfree)
  1400. { if ( s->base == NULL )
  1401.   { fatalError("Not enough core to allocate stacks");
  1402.     return;
  1403.   }
  1404.  
  1405.   s->name     = name;
  1406.   s->top    = s->base;
  1407.   s->limit    = addPointer(s->base, limit);
  1408.   s->minfree    = minfree;
  1409.   s->max    = (char *)s->base + size;
  1410.   s->gced_size = 0L;            /* size after last gc */
  1411.   s->gc           = ((s == (Stack) &LD->stacks.global ||
  1412.            s == (Stack) &LD->stacks.trail) ? TRUE : FALSE);
  1413.   s->small     = (s->gc ? SMALLSTACK : 0);
  1414. }
  1415.  
  1416. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1417. On tos, malloc() returns a 2 byte  aligned  pointer.   We  need  4  byte
  1418. aligned  pointers.   Allocate() is patched for that and dumped states do
  1419. not exist.
  1420. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1421.  
  1422. #if tos
  1423. #define MALLOC(p, n)    Allocate(n)
  1424. #else
  1425. #define MALLOC(p, n)    (!GD->dumped ? malloc(n) : realloc(p, n))
  1426. #endif
  1427.  
  1428. static void
  1429. initStacks(long local, long global, long trail, long arg)
  1430. { long old_heap = GD->statistics.heap;
  1431. #if O_SHIFT_STACKS
  1432.   long itrail  = 32 K;
  1433.   long iglobal = 200 K;
  1434.   long ilocal  = 32 K;
  1435. #else
  1436.   long itrail  = trail;
  1437.   long iglobal = global;
  1438.   long ilocal  = local;
  1439. #endif
  1440.  
  1441.   gBase = (Word) MALLOC(gBase, iglobal + sizeof(word) +
  1442.                    ilocal + sizeof(struct localFrame) +
  1443.                    MAXARITY * sizeof(word));
  1444.   lBase = (LocalFrame)    addPointer(gBase, iglobal+sizeof(word));
  1445.   tBase = (TrailEntry)    MALLOC(tBase, itrail);
  1446.   aBase = (Word *)    MALLOC(aBase, arg);
  1447.  
  1448.   init_stack((Stack)&LD->stacks.global,      "global",   iglobal, global, 100 K);
  1449.   init_stack((Stack)&LD->stacks.local,    "local",    ilocal,  local,   16 K);
  1450.   init_stack((Stack)&LD->stacks.trail,    "trail",    itrail,  trail,    8 K);
  1451.   init_stack((Stack)&LD->stacks.argument, "argument", arg,     arg,      0 K);
  1452.  
  1453.   GD->statistics.heap = old_heap;
  1454. }
  1455.  
  1456. void
  1457. resetStacks()
  1458. { emptyStacks();
  1459. }
  1460.  
  1461. #endif /* O_DYNAMIC_STACKS */
  1462.  
  1463. void
  1464. trimStacks()
  1465. {
  1466. #ifdef O_DYNAMIC_STACKS
  1467.   unmap((Stack) &LD->stacks.local);
  1468.   unmap((Stack) &LD->stacks.global);
  1469.   unmap((Stack) &LD->stacks.trail);
  1470.   unmap((Stack) &LD->stacks.argument);
  1471. #endif /*O_DYNAMIC_STACKS*/
  1472.  
  1473.   LD->stacks.global.gced_size = usedStack(global);
  1474.   LD->stacks.trail.gced_size  = usedStack(trail);
  1475. }
  1476.